home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / TEST / WBATEST.M < prev    next >
Encoding:
Text File  |  1990-02-18  |  10.3 KB  |  331 lines
  1. MODULE WBaTest;
  2.  
  3.  
  4. FROM SYSTEM IMPORT ADDRESS,
  5.                    ADR;
  6.  
  7. IMPORT Terminal;
  8.  
  9. FROM StrConv IMPORT CardToStr;
  10.  
  11. FROM InOut IMPORT WriteString, WriteLn, Read, WriteCard, WriteInt, Write;
  12.  
  13. FROM GrafBase IMPORT Rectangle, Point, white, black, LongRect, LongPnt,
  14.                      BitOperation, MemFormDef,
  15.                      Rect, Pnt, TransRect, LRect, LPnt;
  16.  
  17. FROM GEMGlobals IMPORT FillType, MButtonSet, MouseButton;
  18.  
  19. FROM GEMEnv IMPORT DeviceHandle, RC,
  20.                    InitGem;
  21.  
  22. FROM VDIControls IMPORT SetClipping, DisableClipping;
  23.  
  24. FROM VDIAttributes IMPORT SetFillColor, SetFillType, SetFillIndex;
  25.  
  26. FROM VDIOutputs IMPORT FillRectangle, Ellipse;
  27.  
  28. FROM VDIInputs IMPORT GetMouseState;
  29.  
  30. FROM WindowBase IMPORT Window, WdwElement, WdwElemSet, WdwFlag, WdwFlagSet,
  31.                        WdwState, SetWdwStrMode, WindowSpec, WindowScrollMode,
  32.                        DetectWdwResult, WindowCopyMode,
  33.                        CreateWindow, DeleteWindow, WindowState, OpenWindow,
  34.                        CloseWindow, SetWindowString, WindowWorkArea,
  35.                        GetWindowSpec, SetWindowSpec, UpdateWindow, DetectWindow,
  36.                        ResetWindowState, WindowFlags, PutWindowOnTop;
  37.                        
  38. FROM ScrnCopy   IMPORT CopyOpaque;
  39.  
  40.  
  41. CONST   width                   = 400;
  42.         height                  = 200;
  43.         
  44.         
  45. VAR     ende    : BOOLEAN;
  46.         dev     : DeviceHandle;
  47.         ch      : CHAR;
  48.         
  49.         drawRect: BOOLEAN;
  50.         pos     : LongPnt;
  51.         stdMFDB : MemFormDef;
  52.         
  53.  
  54. PROCEDURE CloseServer (wdw: Window; env: ADDRESS);
  55.  
  56.   BEGIN
  57.     CloseWindow (wdw);
  58.   END CloseServer;
  59.  
  60. PROCEDURE ActiveServer (wdw: Window; env: ADDRESS);
  61.  
  62.   BEGIN
  63.     Terminal.Write (7C);
  64.   END ActiveServer;
  65.  
  66. PROCEDURE UpdateServer (wdw   : Window;
  67.                         env   : ADDRESS;
  68.                         source,
  69.                         dest,
  70.                         new   : Rectangle);
  71.  
  72.   VAR   size    : Rectangle;
  73.         spec    : WindowSpec;
  74.         x0, y0  : INTEGER;
  75.   
  76.   BEGIN
  77.     GetWindowSpec (wdw, spec);
  78.     DisableClipping (dev);
  79.     IF source.w > 0 THEN
  80.       CopyOpaque (dev, ADR (stdMFDB), ADR (stdMFDB), source, dest, onlyS);
  81.     END;
  82.     
  83.     SetClipping (dev, new);
  84.     SetFillColor (dev, white);
  85.     SetFillType (dev, solidFill);
  86.     
  87.     FillRectangle (dev, new);
  88.     
  89.     SetFillColor (dev, black);
  90.     SetFillType (dev, dottPattern);
  91.     SetFillIndex (dev, 16);
  92.     
  93.     WITH size DO
  94.       size := Rect (SHORT (spec.virtual.x), SHORT (spec.virtual.y),
  95.                     SHORT (spec.virtual.w), SHORT (spec.virtual.h));
  96.       Ellipse (dev, Pnt (x + w DIV 2, y + h DIV 2), w DIV 2, h DIV 2);
  97.       SetFillIndex (dev, 18);
  98.       IF drawRect THEN
  99.         FillRectangle (dev, Rect (x + SHORT (pos.x), y + SHORT (pos.y),
  100.                        w DIV 2, h DIV 2))
  101.       END;
  102.     END;
  103.   
  104.   END UpdateServer;
  105.         
  106. PROCEDURE CheckSpecServer (    wdw   :  Window;
  107.                                env   : ADDRESS;
  108.                            VAR spec  : WindowSpec;
  109.                                border: LongRect  );
  110.  
  111.   CONST charAlign       = 8L;   (*  byte aligning  *)
  112.         charW           = 8;
  113.         charH           = 16;
  114.  
  115.   VAR   amt: LONGINT;
  116.   
  117.   BEGIN
  118.     WITH spec DO
  119.     
  120.       IF visible.w > LONG (50) * LONG (charW)
  121.       THEN visible.w := LONG (50) * LONG (charW) END;
  122.     
  123.       (*  Umrechnen in Weltkoor.
  124.        *)
  125.       INC (virtual.x, visible.x);
  126.       INC (virtual.y, visible.y);
  127.       
  128.       visible.w := virtual.x + visible.w - 1L;
  129.       visible.h := virtual.y + visible.h - 1L;
  130.       border.w := border.x + border.w - 1L;
  131.       border.h := border.y + border.h - 1L;
  132.       IF virtual.x < border.x THEN virtual.x := border.x END;
  133.       IF virtual.y < border.y THEN virtual.y := border.y END;
  134.       IF virtual.x > border.w THEN virtual.x := border.w END;
  135.       IF virtual.y > border.h THEN virtual.y := border.h END;
  136.       IF visible.w < border.x THEN visible.w := border.x END;
  137.       IF visible.h < border.y THEN visible.h := border.y END;
  138.       IF visible.w > border.w THEN visible.w := border.w END;
  139.       IF visible.h > border.h THEN visible.h := border.h END;
  140.       visible.w := visible.w - virtual.x + 1L;
  141.       visible.h := visible.h - virtual.y + 1L;
  142.       
  143.       INC (virtual.x, charAlign - 1L); DEC (virtual.x, virtual.x MOD charAlign);
  144.       
  145.       DEC (virtual.x, visible.x);
  146.       DEC (virtual.y, visible.y);
  147.       
  148.       amt := visible.x MOD LONG (charW);
  149.       INC (virtual.x, amt); DEC (visible.x, amt);
  150.       amt := visible.y MOD LONG (charH);
  151.       INC (virtual.y, amt); DEC (visible.y, amt);
  152.       
  153.       DEC (visible.w, visible.w MOD LONG (charW));
  154.       DEC (visible.h, visible.h MOD LONG (charH));
  155.       
  156.     END;
  157.   END CheckSpecServer;
  158. (*
  159.   VAR   amt: LONGINT;
  160.   
  161.   BEGIN
  162.     WITH spec DO
  163.       
  164.       IF visible.w > LONG (width) THEN visible.w := LONG (width) END;
  165.     
  166.       (*  Umrechnen in Weltkoor.
  167.        *)
  168.       INC (visible.x, virtual.x);
  169.       INC (visible.y, virtual.y);
  170.       
  171.       DEC (virtual.x, virtual.x MOD 16L);
  172.       DEC (visible.x, visible.x MOD 16L);
  173.       DEC (visible.w, visible.w MOD 16L);
  174.       
  175.       DEC (virtual.y, virtual.y MOD 16L);
  176.       DEC (visible.y, visible.y MOD 16L);
  177.       DEC (visible.h, visible.h MOD 16L);
  178.       
  179.       visible.w := visible.x + visible.w - 1L;
  180.       visible.h := visible.y + visible.h - 1L;
  181.       INC (border.x, 15L); DEC (border.x, border.x MOD 16L);
  182.       INC (border.y, 15L); DEC (border.y, border.y MOD 16L);
  183.       DEC (border.w, border.w MOD 16L);
  184.       DEC (border.h, border.h MOD 16L);
  185.       border.w := border.x + border.w - 1L;
  186.       border.h := border.y + border.h - 1L;
  187.       IF visible.x < border.x THEN visible.x := border.x END;
  188.       IF visible.y < border.y THEN visible.y := border.y END;
  189.       IF visible.x > border.w THEN visible.x := border.w END;
  190.       IF visible.y > border.h THEN visible.y := border.h END;
  191.       IF visible.w < border.x THEN visible.w := border.x END;
  192.       IF visible.h < border.y THEN visible.h := border.y END;
  193.       IF visible.w > border.w THEN visible.w := border.w END;
  194.       IF visible.h > border.h THEN visible.h := border.h END;
  195.       visible.w := visible.w - visible.x + 1L;
  196.       visible.h := visible.h - visible.y + 1L;
  197.       
  198.       DEC (visible.x, virtual.x);
  199.       DEC (visible.y, virtual.y);
  200.       
  201.     END;
  202.   END CheckSpecServer;
  203.  *)
  204.  
  205. (*$J-*)
  206. PROCEDURE ScrollAmtServer (wdw : Window;
  207.                            env : ADDRESS;
  208.                            mode: WindowScrollMode): LONGINT;
  209.   
  210. (*$J=*)
  211.   VAR   spec: WindowSpec;
  212.   
  213.   BEGIN
  214.     GetWindowSpec (wdw, spec);
  215.     CASE mode OF
  216.       columnLeftWdw,
  217.       columnRightWdw: RETURN 16L|
  218.       rowUpWdw,
  219.       rowDownWdw    : RETURN 16L|
  220.       pageLeftWdw,
  221.       pageRightWdw  : RETURN spec.visible.w|
  222.       pageUpWdw,
  223.       pageDownWdw   : RETURN spec.visible.h|
  224.     END;
  225.   END ScrollAmtServer;
  226.   
  227. PROCEDURE Wait;
  228.  
  229.   VAR     ch      : CHAR;
  230.   
  231.   BEGIN
  232.     Read (ch);
  233.   END Wait;
  234.  
  235. PROCEDURE OkOrNot (value:BOOLEAN);
  236.  
  237.   BEGIN
  238.     IF value THEN WriteString ('OK')
  239.     ELSE WriteString ('An error!') END;
  240.     WriteLn;
  241.   END OkOrNot;
  242.  
  243. VAR     wdw, w2 : Window;
  244.         success : BOOLEAN;
  245.         i       : LONGCARD;
  246.                        
  247.         
  248. PROCEDURE toggleRect;
  249.  
  250.   BEGIN
  251.     drawRect := ~ drawRect;
  252.     UpdateWindow (wdw, UpdateServer, NIL, LRect (pos.x, pos.y, 200L, 100L),
  253.                   noCopyWdw, 0L);
  254.   END toggleRect;
  255.  
  256. PROCEDURE posRect;
  257.  
  258.   VAR   p          : Point;
  259.         lp         : LongPnt;
  260.         buts       : MButtonSet;
  261.         oldDrawRect: BOOLEAN;
  262.         w          : Window;
  263.         res        : DetectWdwResult;
  264.         spec       : WindowSpec;
  265.  
  266.   BEGIN
  267.     GetMouseState (dev, p, buts);
  268.     DetectWindow (wdw, 0, p, w, res);
  269.     IF (msBut1 IN buts) AND (res = foundWdwDWR) THEN
  270.     
  271.       GetWindowSpec (wdw, spec);
  272.       lp := LPnt (LONG (p.x) - spec.virtual.x, LONG (p.y) - spec.virtual.y);
  273.       IF (lp.x < 0L) OR (lp.x >= spec.virtual.w)
  274.          OR (lp.y < 0L) OR (lp.y >= spec.virtual.h)  THEN Write (7C)
  275.       ELSE
  276.         oldDrawRect := drawRect;
  277.         IF oldDrawRect THEN toggleRect END;
  278.         pos := lp;
  279.         IF oldDrawRect THEN toggleRect END;
  280.       END;
  281.       
  282.     END;
  283.   END posRect;
  284.  
  285. VAR     spec: WindowSpec;
  286.         
  287. BEGIN
  288.   stdMFDB.start := NIL;
  289.   drawRect := TRUE;
  290.   InitGem (RC, dev, success);
  291.   IF ~ success THEN HALT END;
  292.   
  293.   pos := LPnt (LONG (width DIV 4), LONG (height DIV 4));
  294.   spec.virtual := LRect (0, 100, width, height);
  295.   spec.visible := LRect (0, 0, 200, 200);
  296.   CreateWindow (wdw, WdwElemSet {infoElem, titleElem, sizeElem, closeElem,
  297.                                  scrollElem},
  298.                 UpdateServer, CheckSpecServer, ScrollAmtServer,
  299.                 ActiveServer, CloseServer, NIL);
  300.   SetWindowString (wdw, titleWdwStr, 'Hallo...');
  301.   SetWindowString (wdw, infoWdwStr, 'Ich informiere...');
  302.   SetWindowSpec (wdw, spec);
  303.   
  304.   OpenWindow (wdw);
  305.   
  306.   (*
  307.   
  308.   CreateWindow (w2, WdwElemSet {infoElem, titleElem, sizeElem, closeElem,
  309.                                 scrollElem},
  310.                UpdateServer, CheckSpecServer, ScrollAmtServer,
  311.                ActiveServer, CloseServer, NIL);
  312.   SetWindowString (w2, titleWdwStr, 'Hallo...');
  313.   SetWindowString (w2, infoWdwStr, 'Ich informiere...');
  314.   SetWindowSpec (w2, spec);
  315.   
  316.   OpenWindow (w2);
  317.    *)
  318.   
  319.   REPEAT
  320.     Read (ch);
  321.     IF ch = ' ' THEN toggleRect END;
  322.     IF ch = 'p' THEN posRect END;
  323.     IF ch = 't' THEN PutWindowOnTop (wdw) END;
  324.   UNTIL ch = 33C;
  325.   
  326.   IF ~ (hiddenWdw IN WindowFlags (wdw)) THEN CloseWindow (wdw) END;
  327.   DeleteWindow (wdw);
  328. END WBaTest.
  329. ə
  330. (* $FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$0000232A$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6C$FFF68D6CÇ$00002653T.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$0000127F$00001269$0000129A$00001268$0000129A$0000111E$00000D14$0000112A$000002E5$000026BB$00002653$00002329$000019BA$00001A5A$00002653$00001287¶ÇÇ*)
  331.